#!/usr/bin/perl -w
use warnings;
use strict;
package InkMap;
use SimpleError;

## [ name, bytes, type, options ]
our @map_header_format = (
    ## ----
    'Wafer Testing Setup Data',
    ['Operator Name', 20, 'C'],
    ['Device Name',   16, 'C', +{ collect => 1 } ],
    ['Wafer Size',     2, 'B'],
    ['Machine No.',    2, 'B'],
    ['Index Size X',   4, 'B'],
    ['Index Size Y',   4, 'B'],
    ['Standard Orientation Flat Direction', 2, 'B'],
    ['Final Editing Maching Type', 1, 'B'],
    ## ----
    '----',
    ['Map Version',    1, 'B', +{ collect => 1 } ],
    ['Map Data Area Row Size',  2, 'B', +{ collect => 1 } ],
    ['Map Data Area Line Size', 2, 'B', +{ collect => 1 } ],
    ['Map Data Form',  4, 'B', +{ collect => 1 } ],
    ## ----
    'Wafer Specific Data',
    ['Wafer ID',      21, 'C', +{ collect => 1 } ],
    ['Number of Probing', 1, 'B', +{ collect => 1 } ],
    ['Lot NO',        18, 'C', +{ collect => 1 } ],
    ['Cassette No.',   2, 'B'],
    ['Slot No.',       2, 'B'],
    ## ----
    'Wafer Probing Coordinate System Data',
    ['X Coordinates Increase Direction', 1, 'B', +{ collect => 1 } ], # 1: leftward, 2: rightward
    ['Y Coordinates Increase Direction', 1, 'B', +{ collect => 1 } ], # 1: forward,  2: backward
    ['Reference Die Setting Procedures', 1, 'B'],
    ['(Reserved)', 1, 'B'],
    ['Target die position X', 4, 'B'],
    ['Target die position Y', 4, 'B'],
    ['Reference die coordinator X', 2, 'B'],
    ['Reference die coordinator Y', 2, 'B'],
    ['Probing Start Position', 1, 'B', +{ collect => 1 } ],
    ['Probing Direction', 1, 'B', +{ collect => 1 } ],
    ['(Reserved)', 2, 'B'],
    ['Distance X to wafer center die origin', 4, 'B'],
    ['Distance Y to wafer center die origin', 4, 'B'],
    ['Coordinator of X of wafer center die', 4, 'B'],
    ['Coordinator of Y of wafer center die', 4, 'B'],
    ## ----
    'Information Per Die',
    ['First Die Coordinator X', 4, 'B'],
    ['First Die Coordinator Y', 4, 'B'],
    ## ----
    'Wafer Testing Start Time Data',
    ['Test Start Year', 2, 'C', +{ collect => 1 } ],
    ['Test Start Month', 2, 'C', +{ collect => 1 } ],
    ['Test Start Day', 2, 'C', +{ collect => 1 } ],
    ['Test Start Hour', 2, 'C', +{ collect => 1 } ],
    ['Test Start Minute', 2, 'C', +{ collect => 1 } ],
    ['(Reserved)', 2, 'B'],
    ## ----
    'Wafer Testing End Time Data',
    ['Test End Year', 2, 'C', +{ collect => 1 } ],
    ['Test End Month', 2, 'C', +{ collect => 1 } ],
    ['Test End Day', 2, 'C', +{ collect => 1 } ],
    ['Test End Hour', 2, 'C', +{ collect => 1 } ],
    ['Test End Minute', 2, 'C', +{ collect => 1 } ],
    ['(Reserved)', 2, 'B'],
    ## ----
    'Wafer Loading Time Data',
    ['Load End Year', 2, 'C', +{ collect => 1 } ],
    ['Load End Month', 2, 'C', +{ collect => 1 } ],
    ['Load End Day', 2, 'C', +{ collect => 1 } ],
    ['Load End Hour', 2, 'C', +{ collect => 1 } ],
    ['Load End Minute', 2, 'C', +{ collect => 1 } ],
    ['(Reserved)', 2, 'B'],
    ## ----
    'Wafer Unloading Time Data',
    ['Unload Start Year', 2, 'C', +{ collect => 1 } ],
    ['Unload Start Month', 2, 'C',  +{ collect => 1 } ],
    ['Unload Start Day', 2, 'C', +{ collect => 1 } ],
    ['Unload Start Hour', 2, 'C', +{ collect => 1 } ],
    ['Unload Start Minute', 2, 'C', +{ collect => 1 } ],
    ['(Reserved)', 2, 'B'],
    ## ----
    '----',
    ['Machine No.', 4, 'B'],
    ['Machine No.', 4, 'B'], # yes, this item repeats, see spec
    ['Special Characters', 4, 'B'],
    'Testing Result',
    ['Testing End Information', 1, 'B', +{ collect => 1 } ],
    ['(Reserved)', 1, 'B'],
    ['Total Tested Dice', 2, 'B', +{ collect => 1 } ], # 1 to 16380
    ['Total Pass Dice',   2, 'B', +{ collect => 1 } ], # 0 to 16380
    ['Total Fail Dice',   2, 'B', +{ collect => 1 } ], # 0 to 16380
    '----',
    ['Test Die Information Address', 4, 'B', +{ collect => 1 } ],
    ['Number Of Line Category Data', 4, 'B'],
    ['Line Category Address', 4, 'B'],
    'Extended Map Information',
    ['Map File Configuration', 2, 'B'],
    ['Max. Multi Site', 2, 'B'],
    ['Max. Categories', 2, 'B'],
    ['Do not use, reserved', 2, 'B'],
);

sub new {
    my $class = shift;
    my $self = +{ @_ };
    bless $self, $class;
    if (defined($self->{Input_File})) {
        $self->read_map($self->{Input_File});
    }
    return $self;
}

# read the binary map data from given file
sub read_map {
    my $self = shift;
    my ($filename) = @_;
    open MAP_FILE, '<', $filename or error("cannot open map data file: $filename: $!");
    binmode MAP_FILE;
    {
        local $/;
        $self->{Map_Data} = <MAP_FILE>;
    }
    $self->{Input_File} = $filename;
    close MAP_FILE or warning("problem when closing map data file: $filename");
    return $self;
}

sub collect_info {
    my $self = shift;
    my ($print) = @_;
    printf STDERR "Map data length: %d bytes\n", length($self->{Map_Data});
    $self->collect_map_info($print);
    $self->collect_die_result($print);
    # message printing
    my @to_print = qw(
        Device_Name
        Lot_NO
        Wafer_ID

        X_Coordinates_Increase_Direction
        Y_Coordinates_Increase_Direction
        Probing_Start_Position
        Probing_Direction
        Testing_End_Information

        Map_Data_Area_Row_Size
        Map_Data_Area_Line_Size

        Total_Pass_Dice
        Total_Fail_Dice
        Total_Tested_Dice
    );
    ## print map information
    SimpleError::message("Map information:");
    for my $k (@to_print) {
        printf STDERR "\t%-32s: %s\n", $k, $self->{Map_Info}{$k}{Value};
    }
    1;
}

sub collect_map_info {
    my $self = shift;
    my ($print) = @_;
    my $fpos = 0;
    for my $i (0 .. $#map_header_format) {
        my $header_spec = $map_header_format[$i];
        if (ref($header_spec) ne 'ARRAY') {
            print "* $header_spec:\n" if $print;
            next;
        }
        my ($data_name, $data_size, $data_type, $config) = @$header_spec;
        my $data_bytes = substr $self->{Map_Data}, $fpos, $data_size;
        my $header_result = interpret_header($data_bytes, $data_type, $data_size);
        if ($print) {
            my $nibbles = $data_size * 2;
            my $additional_info = $data_type eq 'B' ?
                sprintf("(0x%0${nibbles}x)", $header_result) : sprintf("(%d)", length($header_result));
            printf "  %04X (%2d): %-36s: |%s| %s\n",
                $fpos, $data_size, $header_spec->[0],
                $header_result, $additional_info;
        }
        # collect required information for further access
        if (defined($config->{collect})) {
            (my $key = $header_spec->[0]) =~ s/ /_/g;
            $self->{Map_Info}{ $key } = +{
                Value  => $header_result,
                Offset => $fpos,
                Size   => $data_size,
                Type   => $data_type,
            };
        }
        ## update fpos
        $fpos += $data_size;
    }
    1;
}

sub collect_die_result {
    my $self = shift;
    my ($print) = @_;
    error('Map information not collected yet.') unless defined($self->{Map_Info});
    my $data_size = 6; # fixed at 6 bytes, or 3 words
    my $total_map_cells   =
        $self->{Map_Info}{Map_Data_Area_Row_Size}{Value} * $self->{Map_Info}{Map_Data_Area_Line_Size}{Value};
    my $total_tested_dice = $self->{Map_Info}{Total_Tested_Dice}{Value};
    my $total_pass_dice   = $self->{Map_Info}{Total_Pass_Dice}{Value};
    my $total_fail_dice   = $self->{Map_Info}{Total_Fail_Dice}{Value};
    my $fpos = $self->{Map_Info}{Test_Die_Information_Address}{Value}
        or error('Test Die Information Address not available!');
    my %result = (
        Die_Property         => [ 0, 0, 0 ],
        Die_Test_Result      => [ 0, 0, 0, 0 ],
        Fail_Mark_Inspection => [ 0, 0 ],
        Re_Probing_Result    => [ 0, 0, 0, 0 ],
    );
    message("total map cells: $total_map_cells");
    #for my $i (1 .. $total_tested_dice) {
    #for (my $i = 1; $fpos < length($self->{Map_Data}); $i++) {
    for (my $i = 1; $i <= $total_map_cells; $i++) {
        my $data_bytes = substr $self->{Map_Data}, $fpos, $data_size;
        my $die_result = interpret_die_result($data_bytes);
        my ($xadr, $yadr) = @{$die_result}[0 .. 1];
        $self->{Die_Result}[$i - 1] = $die_result;
        $self->{Die_Table}{$xadr}{$yadr} = [$fpos, $die_result];
        print_die_result($i, $fpos, $die_result) if ($print);
        $fpos += $data_size;
        ## statistical
        $result{Die_Property}[ $die_result->[3] ]         += 1;
        $result{Die_Test_Result}[ $die_result->[4] ]      += 1;
        $result{Re_Probing_Result}[ $die_result->[5] ]    += 1;
        $result{Fail_Mark_Inspection}[ $die_result->[7] ] += 1;
    }
    ## summary printing
    message("Gross summary:");
    printf STDERR "Die Property   : Skip=%d, Probing=%d, Comp. Mark=%d\n", @{$result{Die_Property}};
    printf STDERR "Die Test Result: NT=%d, PASS=%d, FAIL-1=%d, FAIL-2=%d\n", @{$result{Die_Test_Result}};
    printf STDERR "Re-Probe Result: NR=%d, RP-PASS=%d, RP-Fail=%d, (n/a)=%d\n", @{$result{Re_Probing_Result}};
    printf STDERR "FMark Insepect.: YES=%d, NO=%d\n", @{$result{Fail_Mark_Inspection}};

    1;
}

sub read_pf {
    my $self = shift;
    my ($filename) = @_;
    my @pf_list;
    my ($pass, $fail, $total) = (0, 0, 0);
    open PF_LIST, '<', $filename or error("cannot open file: $filename: $!");
    while (<PF_LIST>) {
        chomp;
        if (/^(-?\d+)[\s,]+(-?\d+)[^\d\"]+\"?(\w+)\"?/) {
            my ($xadr, $yadr, $pf) = ($1, $2, $3);
            if ($pf =~ /^P/i) {
                $pf = 'P';
                $pass++;
            } else {
                $pf = 'F';
                $fail++;
            }
            $total++;
            push @pf_list, [$xadr, $yadr, $pf];
        } else {
            print STDERR "MISMATCH-LINE: $_\n";
        }
    }
    close PF_LIST;
    error("Pass + Fail != Total?") unless ($pass + $fail == $total);
    $self->{PF_List} = \@pf_list;
    $self->{PF_Info} = +{
        Pass  => $pass,
        Fail  => $fail,
        Total => $total,
    };
    SimpleError::message("PF from file '$filename':");
    SimpleError::message("  Pass : $pass");
    SimpleError::message("  Fail : $fail");
    SimpleError::message("  Total: $total");
    return $self;
}

sub update_pf {
    my $self = shift;
    ## check the given PF_List is conformant with the original
    ## map data (i.e., gross dies)
    error("Gross dies mismatch: Original: $self->{Map_Info}{Total_Tested_Dice}{Value}, Given: $self->{PF_Info}{Total}")
        unless ($self->{PF_Info}{Total} == $self->{Map_Info}{Total_Tested_Dice}{Value});
    ## meta data update
    $self->write_bytes($self->{PF_Info}{Pass}, @{ $self->{Map_Info}{Total_Pass_Dice} }{qw(Offset Size Type)});
    $self->write_bytes($self->{PF_Info}{Fail}, @{ $self->{Map_Info}{Total_Fail_Dice} }{qw(Offset Size Type)});
    ## die result update
    for my $i (0 .. $#{$self->{PF_List}}) {
        my $pf_item = $self->{PF_List}[$i];
        my $ic_no   = $i + 1;
        my ($xadr, $yadr, $pf) = @$pf_item;
        my ($offset, $die_result) = @{ $self->{Die_Table}{$xadr}{$yadr} };
        $self->write_die_result($offset, $pf, $die_result);
    }
    1;
}

sub write_bytes {
    my $self = shift;
    my ($value, $offset, $size, $type) = @_;
    my $no_nibbles = $size * 2;
    my $new_bytes =
        $type eq 'B' ? pack( "H${no_nibbles}", sprintf("%0${no_nibbles}X", $value) )
        : $type eq 'C' ? $value
        : error("Unknown type: $type");
    # in-place update the bytes
    substr($self->{Map_Data}, $offset, $size, $new_bytes);
    1;
}

sub write_die_result {
    my $self = shift;
    my ($offset, $pf, $die_result) = @_;
    my $new_bytes = make_die_result($die_result->[2], $pf);
    substr($self->{Map_Data}, $offset, 6, $new_bytes);
    return $new_bytes;
}

sub save_map {
    my $self = shift;
    my ($filename) = @_;
    open my $fh, '>', $filename or error("$filename: cannot open: $!");
    print $fh $self->{Map_Data};
    close $fh;
    1;
}

## ======================================================================
## class method
## ======================================================================

sub interpret_header {
    my ($data_bytes, $data_type, $data_size) = @_;
    if ($data_type eq 'C') {
        $data_bytes =~ s/^[\s\000]+//;
        $data_bytes =~ s/[\s\000]+$//;
        return $data_bytes;
    } elsif ($data_type eq 'B') {
        my $pack_format = sprintf("H%d", 2 * $data_size);
        return hex(unpack($pack_format, $data_bytes));
    } else {
        error("Unknown data type: $data_type");
    }
    1;
}

sub print_die_result {
    my ($no, $addr, $data) = @_;
    ## reset mask bit (word 1, bit 13, or index 2 from left to right)
    my $bin_str = unpack("B*", pack("H*", $data->[2]));
    #substr $bin_str, 2, 1, '0'; # reset Marking to '0' ('No')
    printf "[%4d]0x%04x: (%3d,%3d) %-64s",
        $no, $addr,
        $data->[0], $data->[1],
        separate_bin_str($bin_str);
    print ' => ', join(' ',
        qw(SK PR CM)[$data->[3]],    # die property: SKIP PROBING COMPULSORY-MARKING
        qw(NT PA F1 F2)[$data->[4]], # test result: NOT-TESTED PASS FAIL-1 FAIL-2
        qw(NR RP RF NA)[$data->[5]], # re-probing result: NOR-REPROBED REPROBED-PASS REPROBED-FAIL NOT-AVAILABLE
        qw(MN MY)[$data->[6]],       # marking: MARKING-NO MARKING-YES
        qw(IY IN)[$data->[7]],       # fail mark inspection: INSPECTION-YES INSPECTION-NO
    ), "\n";
    1;
}

sub interpret_die_result {
    my ($data_bytes) = @_;
    my $hex_value = unpack('H12', $data_bytes); # 6 bytes per one die result
    my $word_1 = hex(substr($hex_value, 0, 4));
    my $word_2 = hex(substr($hex_value, 4, 4));
    my $word_3 = hex(substr($hex_value, 8, 4));
    my $x_addr = ($word_1 & 0x01FF) * (($word_2 & 0x0800) ? -1 : 1);
    my $y_addr = ($word_2 & 0x01FF) * (($word_2 & 0x0400) ? -1 : 1);
    # ('Skip Die', 'Probing Die', 'Compulsory Marking Die')
    my $die_property = ($word_2 & 0xC000) >> 14;
    my $die_test_result = ($word_1 & 0xC000) >> 14;
    my $marking = ($word_1 & 0x2000) >> 13;
    my $fail_mark_inspection = ($word_1 & 0x1000) >> 12;
    my $re_probing_result = ($word_1 & 0x0c00) >> 10;
    my $needle_mark_inspection = ($word_1 & 0x0200) >> 9;
    return [
        $x_addr,                    # [0]
        $y_addr,                    # [1]
        $hex_value,                 # [2]
        $die_property,              # [3]
        $die_test_result,           # [4]
        $re_probing_result,         # [5]
        $marking,                   # [6]
        $fail_mark_inspection,      # [7]
        $needle_mark_inspection,    # [8]
    ];
}

sub make_die_result {
    my ($hex_str, $pf) = @_;
    my $word1 = hex(substr($hex_str, 0, 4));
    #my $word2 = hex(substr($hex_str, 4, 4));
    #my $word3 = hex(substr($hex_str, 8, 4));
    ## common settings
    # word1[13] = 1'b0 -> marking: no
    # word1[11:10] = 2'b00 -> re-probing result = not reprobed
    $word1 |= 0x2000; # set bit 13
    $word1 &= 0xF3FF; # reset bit 11, 10
    # $word1 &= 0xD3FF;
    if ($pf eq 'P') {
        # word1[15:14] = 2'b01 -> die result = pass
        $word1 &= 0x7FFF; # reset bit 15
        $word1 |= 0x4000; # set bit 14
    } elsif ($pf eq 'F') {
        # word1[15:14] = 2'b10 -> die result = fail 1 die
        $word1 |= 0x8000; # set bit 15
        $word1 &= 0xBFFF; # reset bit 14
    } else {
        error("$pf: unknown pass/fail character");
    }
    # update the hex string
    substr($hex_str, 0, 4, sprintf('%04x', $word1));
    # return the machine number
    return pack('H12', $hex_str);
}

sub separate_bin_str($) {
    my ($str) = @_;
    my @octals;
    for (my $i = 0; $i < length($str); $i += 8) {
        push @octals, sprintf('%s,%s', substr($str, $i, 4), substr($str, $i + 4, 4));
    }
    ## nibbles separated by ','; octals separated by ' '; words separated by ' | '
    return join(' | ',
        map(
            sprintf('%s %s',
                $octals[$_ * 2],
                (defined($octals[$_ * 2 + 1]) ? $octals[$_ * 2 + 1] : '')
            ), 0 .. (int((@octals+1)/2) - 1)
        )
    );
}

1;
